The CICA Windows Explosion!/The CICA Windows Explosion! - Disc 2.iso/demo/vtskt10i.zip/FTP_FORM.FRM

Text File | 1994-02-13 | 40KB | 1,633 lines

VERSION 2.00
Begin Form ftp_form
   Caption         =   "VT File Transfer"
   ClientHeight    =   4845
   ClientLeft      =   1080
   ClientTop       =   1755
   ClientWidth     =   7275
   Height          =   5535
   Icon            =   FTP_FORM.FRX:0000
   Left            =   1020
   LinkTopic       =   "Form1"
   ScaleHeight     =   4845
   ScaleWidth      =   7275
   Top             =   1125
   Width           =   7395
   Begin WinSock ftpdata
      Client_or_Server=   1  'Server
      Index           =   0
      Interval        =   0
      IPName          =   ""
      Left            =   630
      LicDate         =   0
      License1        =   ""
      License2        =   ""
      Licensed        =   0
      Linger          =   0   'False
      Port            =   0
      RecvBufSize     =   0
      SendBufSize     =   0
      Top             =   4320
   End
   Begin WinSock ftpcntl
      Client_or_Server=   0  'Client
      Interval        =   0
      IPName          =   ""
      Left            =   150
      LicDate         =   0
      License1        =   ""
      License2        =   ""
      Licensed        =   0
      Linger          =   0   'False
      Port            =   0
      RecvBufSize     =   0
      SendBufSize     =   0
      Top             =   4320
   End
   Begin PictureBox transfer_child
      BackColor       =   &H00C0C0C0&
      Height          =   1185
      Left            =   210
      ScaleHeight     =   1155
      ScaleWidth      =   5805
      TabIndex        =   19
      Top             =   2820
      Visible         =   0   'False
      Width           =   5835
      Begin CommandButton transfer_cancel
         Caption         =   "Cancel"
         Height          =   405
         Left            =   2520
         TabIndex        =   20
         Top             =   690
         Width           =   855
      End
      Begin Shape pct_cmpl
         BackColor       =   &H00FF0000&
         BackStyle       =   1  'Opaque
         Height          =   345
         Left            =   60
         Top             =   300
         Width           =   75
      End
      Begin Label pct_box
         BorderStyle     =   1  'Fixed Single
         Height          =   345
         Left            =   60
         TabIndex        =   27
         Top             =   300
         Width           =   5655
      End
      Begin Label Label3
         BackColor       =   &H00C0C0C0&
         Caption         =   "File transfer is in progress.  Press CANCEL to ABORT the transfer."
         Height          =   285
         Left            =   60
         TabIndex        =   21
         Top             =   30
         Width           =   5685
      End
      Begin Label Label6
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Left            =   1050
         TabIndex        =   22
         Top             =   150
         Width           =   3495
      End
   End
   Begin PictureBox function_child
      BackColor       =   &H00C0C0C0&
      Height          =   1575
      Left            =   2490
      ScaleHeight     =   1545
      ScaleWidth      =   4575
      TabIndex        =   12
      Top             =   2880
      Visible         =   0   'False
      Width           =   4605
      Begin TextBox copy_rename
         Height          =   315
         Left            =   1050
         TabIndex        =   26
         Top             =   750
         Width           =   3495
      End
      Begin CommandButton copy_button
         Caption         =   "Copy"
         Height          =   405
         Left            =   1440
         TabIndex        =   11
         Top             =   1110
         Width           =   855
      End
      Begin CommandButton cancel_button
         Caption         =   "Cancel"
         Height          =   405
         Left            =   2340
         TabIndex        =   13
         Top             =   1110
         Width           =   855
      End
      Begin Label Label4
         BackColor       =   &H00C0C0C0&
         Caption         =   "Rename?"
         Height          =   285
         Left            =   90
         TabIndex        =   25
         Top             =   810
         Width           =   855
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Copy to:"
         Height          =   255
         Left            =   90
         TabIndex        =   10
         Top             =   480
         Width           =   945
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Copy from:"
         Height          =   225
         Left            =   90
         TabIndex        =   16
         Top             =   150
         Width           =   945
      End
      Begin Label copy_to
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   1  'Fixed Single
         Height          =   285
         Left            =   1050
         TabIndex        =   15
         Top             =   450
         Width           =   3495
      End
      Begin Label copy_from
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   1  'Fixed Single
         Height          =   285
         Left            =   1050
         TabIndex        =   14
         Top             =   150
         Width           =   3495
      End
   End
   Begin SSPanel status_box
      Align           =   1  'Align Top
      Alignment       =   1  'Left Justify - MIDDLE
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Height          =   720
      Left            =   0
      TabIndex        =   9
      Top             =   2085
      Width           =   7275
      Begin PictureBox trash
         AutoSize        =   -1  'True
         Height          =   600
         Left            =   5970
         Picture         =   FTP_FORM.FRX:0302
         ScaleHeight     =   570
         ScaleWidth      =   570
         TabIndex        =   24
         Top             =   60
         Width           =   600
      End
      Begin PictureBox info
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         Height          =   600
         Left            =   6600
         Picture         =   FTP_FORM.FRX:0D2C
         ScaleHeight     =   570
         ScaleWidth      =   570
         TabIndex        =   23
         Top             =   60
         Width           =   600
      End
      Begin ListBox status_list
         Height          =   615
         Left            =   45
         TabIndex        =   6
         Top             =   45
         Width           =   4440
      End
   End
   Begin SSPanel rfile_frame
      Align           =   1  'Align Top
      AutoSize        =   3  'AutoSize Child To Panel
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Caption         =   "Panel3D1"
      Height          =   810
      Left            =   0
      TabIndex        =   8
      Top             =   495
      Width           =   7275
      Begin Outline lfile
         DragIcon        =   FTP_FORM.FRX:1756
         Height          =   720
         Left            =   45
         PictureClosed   =   FTP_FORM.FRX:1A58
         PictureLeaf     =   FTP_FORM.FRX:1BB2
         PictureMinus    =   FTP_FORM.FRX:1D0C
         PictureOpen     =   FTP_FORM.FRX:1E66
         PicturePlus     =   FTP_FORM.FRX:1FC0
         TabIndex        =   4
         Top             =   45
         Width           =   7185
      End
   End
   Begin SSPanel drive_frame
      Align           =   1  'Align Top
      BorderWidth     =   1
      Height          =   495
      Left            =   0
      TabIndex        =   7
      Top             =   0
      Width           =   7275
      Begin SSPanel options_frame
         Alignment       =   1  'Left Justify - MIDDLE
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Caption         =   " Xfer Options"
         Height          =   435
         Left            =   4020
         TabIndex        =   18
         Top             =   30
         Width           =   3225
         Begin CommandButton button_type
            Caption         =   "ASCII"
            Height          =   375
            Left            =   1230
            TabIndex        =   2
            Top             =   30
            Width           =   975
         End
         Begin CommandButton button_mode
            Caption         =   "Stream"
            Height          =   375
            Left            =   2220
            TabIndex        =   3
            Top             =   30
            Width           =   975
         End
      End
      Begin SSPanel Panel3D1
         Alignment       =   1  'Left Justify - MIDDLE
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         Caption         =   " Local Drive"
         Height          =   435
         Left            =   30
         TabIndex        =   17
         Top             =   30
         Width           =   3945
         Begin DriveListBox Drive1
            BackColor       =   &H00C0C0C0&
            ForeColor       =   &H00000000&
            Height          =   315
            Left            =   1110
            TabIndex        =   1
            Top             =   60
            Width           =   2775
         End
      End
   End
   Begin SSPanel lfile_frame
      Align           =   1  'Align Top
      AutoSize        =   3  'AutoSize Child To Panel
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Caption         =   "Panel3D1"
      Height          =   780
      Left            =   0
      TabIndex        =   0
      Top             =   1305
      Width           =   7275
      Begin Outline rfile
         DragIcon        =   FTP_FORM.FRX:211A
         Enabled         =   0   'False
         Height          =   690
         Left            =   45
         PathSeparator   =   "/"
         PictureClosed   =   FTP_FORM.FRX:241C
         PictureLeaf     =   FTP_FORM.FRX:2576
         PictureMinus    =   FTP_FORM.FRX:26D0
         PictureOpen     =   FTP_FORM.FRX:282A
         PicturePlus     =   FTP_FORM.FRX:2984
         TabIndex        =   5
         Top             =   45
         Width           =   7185
      End
   End
   Begin Menu menu_file
      Caption         =   "&File"
      Begin Menu menu_connect
         Caption         =   "&Connect"
      End
      Begin Menu menu_disconnect
         Caption         =   "&Disconnect"
      End
      Begin Menu menu_exit
         Caption         =   "E&xit"
      End
   End
   Begin Menu menu_options
      Caption         =   "&Options"
      Begin Menu menu_lcl_refresh
         Caption         =   "&Local Structure Refresh"
      End
      Begin Menu menu_rmt_refresh
         Caption         =   "&Remote Structure Refresh"
      End
      Begin Menu menu_xfer
         Caption         =   "&File Transfer"
         Begin Menu menu_type
            Caption         =   "&Type"
            Begin Menu menu_type_ascii
               Caption         =   "&ASCII"
               Checked         =   -1  'True
            End
            Begin Menu menu_type_binary
               Caption         =   "&Binary"
            End
         End
         Begin Menu menu_mode
            Caption         =   "&Mode"
            Begin Menu menu_mode_stream
               Caption         =   "&Stream"
               Checked         =   -1  'True
            End
            Begin Menu menu_mode_block
               Caption         =   "&Block"
            End
            Begin Menu menu_mode_compressed
               Caption         =   "&Compressed"
               Enabled         =   0   'False
               Visible         =   0   'False
            End
         End
         Begin Menu menu_port_cycle
            Caption         =   "&Cycle Port Numbers"
            Checked         =   -1  'True
         End
      End
      Begin Menu menu_other
         Caption         =   "&Status Messages"
         Begin Menu menu_verbose
            Caption         =   "&Verbose Status"
            Checked         =   -1  'True
         End
      End
   End
End
Const DATA_PORT = 8        ' this value * 256 is data port number
Const MAX_BLKSIZE = 1024   ' maximum data to send in a single request

Dim cbuf As String         ' buffer for inbound control messages
Dim dbuf As String         ' buffer for inbound data

Dim lfile_path As String
Dim lfile_name As String
Dim rfile_path As String
Dim rfile_name As String

Dim data_type As Integer   ' used to control list and copy
Const DT_RECEIVE = 0
Const DT_SEND = 1
Const DT_LIST = 2

Dim data_socket As Integer ' 0 - disconnected, not0 - data socket number
Dim data_file As Integer   ' input or output disk file handle

Dim txth As Integer        ' height of font in outline boxes

' TELNET negotiation

Dim parsedata(10) As Integer
Dim ppno As Integer

Dim sw_ugoahead As Integer
Dim sw_igoahead As Integer
Dim sw_echo As Integer
Dim sw_termsent As Integer
Dim substate As Integer

Const GO_NORM = 0
Const GO_IAC1 = 1
Const GO_IAC2 = 2
Const GO_IAC3 = 3
Const GO_IAC4 = 4
Const GO_IAC5 = 5
Const GO_IAC6 = 6

Const SE = 240
Const SB = 250
Const WILLTEL = 251
Const WONTTEL = 252
Const DOTEL = 253
Const DONTTEL = 254
Const IAC = 255

Const ECHO = 1
Const SGA = 3
Const TIMING = 6
Const TERMTYPE = 24
Const NAWS = 31

Sub button_mode_Click ()

  If button_mode.Caption = "Stream" Then
    menu_mode_block_click
  'ElseIf button_mode.Caption = "Block" Then
  '  menu_mode_compressed_click
  Else
    menu_mode_stream_click
  End If

End Sub

Sub button_type_Click ()

  If button_type.Caption = "ASCII" Then
    menu_type_binary_click
  Else
    menu_type_ascii_click
  End If

End Sub

Sub cancel_button_Click ()

  function_child.Visible = False
  lfile.DragMode = 0
  rfile.DragMode = 0

End Sub

Function cntl_recv (lowest_return As Integer) As Integer

  Do While True
    z = DoEvents() ' let the receive events fire at will
    p = InStr(cbuf, Chr$(10))
    If p Then
      cmsg$ = Left$(cbuf, p - 1)
      cbuf = Right$(cbuf, Len(cbuf) - p)
      status_list.AddItem "<-- " + cmsg$, 0
      If status_list.ListCount = 50 Then
        status_list.RemoveItem 49
      End If

      If Mid$(cmsg$, 4, 1) <> "-" Then
        st = Val(Left$(cmsg$, 1))
        If st >= lowest_return Then ' don't pass back intermediate messages
          cntl_recv = st
          Exit Function
        End If
      End If
    End If
  Loop

End Function

Sub cntl_send (m As String)

  If Left$(m, 4) = "PASS" And Mid$(m, 6, 9) <> "anonymous" Then
    If menu_verbose.Checked Then
      log_message "--> PASS *"
    End If
    ftpcntl.Send = m + Chr$(13) + Chr$(10)
  ElseIf Left$(m, 1) = Chr$(255) Then
    ftpcntl.Send = m
  Else
    If menu_verbose.Checked Then
      log_message "--> " + m
    End If
    ftpcntl.Send = m + Chr$(13) + Chr$(10)
  End If

End Sub

Sub copy_button_Click ()

  mousepointer = HOURGLASS

  function_child.Visible = False
  lfile.DragMode = 0
  rfile.DragMode = 0

  transfer_child.Left = (ftp_form.Width - transfer_child.Width) / 2
  transfer_child.Top = drive1.Height + 500
  transfer_child.Visible = True
  copy_file
  transfer_child.Visible = False
  mousepointer = DEFAULT

End Sub

Sub copy_file ()

Dim filesize As Long
Dim todo As Long
Dim sofar As Long
Dim every10 As Integer

  If button_type.Caption = "ASCII" Then
    cntl_send "TYPE A"
  Else
    cntl_send "TYPE I"
  End If
  If 2 <> cntl_recv(2) Then
    Exit Sub
  End If

  If button_mode.Caption = "Stream" Then
    cntl_send "MODE S"
  ElseIf button_mode.Caption = "Block" Then
    cntl_send "MODE B"
  Else
    cntl_send "MODE C"
  End If
  If 2 <> cntl_recv(2) Then
    Exit Sub
  End If

  open_data_port
  If 2 <> cntl_recv(2) Then
    Exit Sub
  End If

  On Error GoTo recover

  Select Case data_type
    Case DT_RECEIVE
      pct_cmpl.Visible = False
      pct_box.Visible = False
      data_file = FreeFile
      Open lfile_path + "/" + Trim$(copy_rename.Text) For Output As data_file
      cntl_send "RETR " + rfile_path
      st = cntl_recv(1)           ' wait for starting... message
      If 1 = st Then
        If 2 <> cntl_recv(2) Then ' wait for finished... message
          Close data_file
          Exit Sub
        End If
      ElseIf 2 <> st Then
        Close data_file
        Exit Sub
      End If

      Do While data_socket <> 0   ' wait for server to close
        z = DoEvents()
      Loop

    Case DT_SEND
      pct_cmpl.Width = 0
      pct_box.Visible = True
      pct_cmpl.Visible = True
      cntl_send "STOR " + rfile_path + "/" + Trim$(copy_rename.Text)
      If 1 <> cntl_recv(1) Then
        Close data_file
        Exit Sub
      End If
      Do While data_socket = 0    ' wait for server to connect
        z = DoEvents()
      Loop

      If button_type.Caption = "ASCII" Then
        data_file = FreeFile
        Open lfile_path For Input As data_file
        filesize = LOF(data_file)
        Do While Not EOF(data_file)
          If transfer_child.Visible = False Then
            Close data_file
            Exit Sub
          End If
          Line Input #data_file, blk$
          If Len(blk$) > MAX_BLKSIZE Then
            Close data_file
            MsgBox "Line exceed FTP buffer size, use BINARY transfer"
            cntl_send "ABOR"
            Do While 2 <> cntl_recv(2): Loop
            Exit Do
          End If
          blk$ = blk$ + Chr$(13) + Chr$(10)
          GoSub send_block
        Loop
      Else
        data_file = FreeFile
        Open lfile_path For Binary Access Read As data_file Len = MAX_BLKSIZE
        filesize = LOF(data_file)
        todo = filesize
        Do While todo > 0
          If transfer_child.Visible = False Then
            Close data_file
            Exit Sub
          End If
          If todo >= MAX_BLKSIZE Then
            blk$ = String$(MAX_BLKSIZE, 0)
            todo = todo - MAX_BLKSIZE
          Else
            blk$ = String$(doto, 0)
            todo = 0
          End If
          Get data_file, , blk$
          GoSub send_block
        Loop
      End If
      Select Case button_mode.Caption
        Case "Stream"
        Case "Block"
          ftpdata(data_socket).Send = Chr$(64) + Chr$(0) + Chr$(0)
        Case "Compress"
          ' some day, maybe
      End Select

      ftpdata(data_socket).Open = False ' tell server we're done
      z = cntl_recv(2)
      Do While 0 <> data_socket
        z = DoEvents()
      Loop

  End Select

  Close data_file
  Exit Sub

send_block:

  ln = Len(blk$)
  Select Case button_mode.Caption
    Case "Stream"
      ftpdata(data_socket).Send = blk$
    Case "Block"
      If button_type.Caption = "ASCII" Then
        hdr$ = Chr$(128)
      Else
        hdr$ = Chr$(0)
      End If
      hdr$ = hdr$ + Chr$(ln / 256) + Chr$(ln And &HFF)
      ftpdata(data_socket).Send = hdr$ + blk$
    Case "Compress"
      ' some day, maybe
  End Select

  sofar = sofar + ln
  every10 = every10 + 1
  If every10 > 9 Then
    every10 = 0
    pct_cmpl.Width = pct_box.Width * (sofar / filesize)
  End If

  blk$ = ""

  Return

recover:

  MsgBox "Error" + Str$(Err) + " encountered during copy, copy cancelled"
  ftpdata(data_socket).Open = False
  Do While data_socket <> 0
    z = DoEvents()
  Loop
  Close data_file
  Exit Sub

End Sub

Sub Drive1_Change ()

  ChDrive drive1.List(drive1.ListIndex)
  local_dir True

End Sub

Sub Form_Load ()

Dim ln As String * 80
Dim nm As String

  FontName = lfile.FontName
  FontSize = lfile.FontSize
  txth = TextHeight("A")

  z = GetINIString("Settings", "Verbose", "", ln, 80, "vtftp.ini")
  menu_verbose.Checked = Val(ln)

  z = GetINIString("Settings", "CyclePort", "", ln, 80, "vtftp.ini")
  menu_port_cycle.Checked = Val(ln)

  For X = 1 To 99
    nm = "IP" + Trim$(Str$(X))
    lnsz = GetINIString("FTP Sites", nm, "", ln, 80, "vtftp.ini")
    If lnsz > 0 Then
      connect_form.conn_ipname.AddItem Trim$(ln)
    End If
  Next X

  local_dir True

End Sub

Sub Form_Resize ()

  If ftp_form.Width < 7395 Then
    ftp_form.Width = 7395
  End If

  h = (ftp_form.Height - (drive_frame.Height + status_box.Height)) / 2 - 350
  lfile_frame.Height = h
  rfile_frame.Height = h

  status_list.Height = status_box.Height - 25
  status_list.Width = ftp_form.Width - 1500
  info.Left = ftp_form.Width - (info.Width + 200)
  trash.Left = info.Left - (trash.Width + 25)

End Sub

Sub Form_Unload (Cancel As Integer)

  menu_exit_click

End Sub

Sub ftpcntl_Recv ()

Static cmd As Integer

Dim X As Integer
Dim s, ch As String

  s = ftpcntl.Recv
  For X = 1 To Len(s)
    ch = Mid$(s, X, 1)
    Select Case cmd
      Case GO_NORM
        If ch = Chr$(IAC) Then
          cmd = GO_IAC1
        ElseIf ch = Chr$(13) Or ch = Chr$(31) Then ' skip LF's to keep things simple
        Else
          cbuf = cbuf + ch
        End If
      Case GO_IAC1
        cmd = iac1(ch)
      Case GO_IAC2
        cmd = iac2(ch)
      Case GO_IAC3
        cmd = iac3(ch)
      Case GO_IAC4
        cmd = iac4(ch)
      Case GO_IAC5
        cmd = iac5(ch)
      Case GO_IAC6
        cmd = iac6(ch)
      Case Else
        MsgBox "Invalid 'next (" + Str$(cmd) + ")' processing routine in cmd loop"
    End Select
  Next X

End Sub

Sub ftpdata_Connect (index As Integer, ID As Integer)

  Load ftpdata(ID)
  data_socket = ID

  log_message "     Data Port Connected (" + Trim$(Str$(ID)) + ")"

End Sub

Sub ftpdata_Disconnect (index As Integer)

  log_message "     Data Port Disconnected (" + Trim$(Str$(index)) + ")"

  If ftpdata(index).Open Then
    ftpdata(index).Open = False
  End If
  data_socket = 0
  Unload ftpdata(index)

End Sub

Sub ftpdata_Recv (index As Integer)

Dim c As Integer
Dim l As Integer

  Select Case data_type
    Case DT_RECEIVE
      Select Case button_mode.Caption
        Case "Stream"
          blk$ = ftpdata(index).Recv
          Do While blk$ <> ""
            Print #data_file, blk$;
            blk$ = ftpdata(index).Recv
          Loop
        Case "Block"
          blk$ = ftpdata(index).Recv
          Do While blk$ <> ""
            c = Asc(Left$(blk$, 1))
            l = Asc(Mid$(blk$, 2, 1)) * 256 + Asc(Mid$(blk$, 3, 1))
            If l Then
              Print #data_file, Mid$(blk$, 3, l);
            End If
            If c And 128 Then  ' end of record
              Print #data_file,
            End If
            If c And 64 Then   ' end of file
              blk$ = ""
              ftpdata(index).Open = False
            Else
              blk$ = Right$(blk$, Len(blk$) - 3) + ftpdata(index).Recv
            End If
          Loop
        Case "Compress"
          ' add decompression logic here
      End Select
    Case DT_SEND
      MsgBox ("ERROR:  INBOUND data received on OUTBOUND connection")
    Case DT_LIST
      dbuf = dbuf + ftpdata(index).Recv
  End Select

End Sub

Function iac1 (ch As String) As Integer

  iac1 = GO_NORM

  Select Case Asc(ch)
    Case DOTEL
      Debug.Print "DO ";
      iac1 = GO_IAC2
    Case DONTTEL
      Debug.Print "DONT "
    Case WILLTEL
      Debug.Print "WILL ";
      iac1 = GO_IAC3
    Case WONTTEL
      Debug.Print "WONT ";
      iac1 = GO_IAC4
    Case SB
      Debug.Print "SB ";
      iac1 = GO_IAC5
      pno = 0
      substate = 0
    Case SE
      Debug.Print "SE "
      ' End of negotiation string, string is in parsedata()
      Select Case parsedata(0)
        Case TERMTYPE
          If parsedata(1) = 1 Then
            Debug.Print "SENT: SB TERMTYPE VT100"
            ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(SB) + Chr$(TERMTYPE) + "vt100" + Chr$(0) + Chr$(IAC) + Chr$(SE)
          End If
      End Select
  End Select

End Function

Function iac2 (ch As String) As Integer

  'DO Processing

  iac2 = GO_NORM

  Select Case Asc(ch)
    Case SGA
      Debug.Print "SGA"
      If Not sw_igoahead Then
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(WILLTEL) + Chr$(SGA)
        sw_igoahead = True
      End If
    Case TERMTYPE
      Debug.Print "TERMTYPE"
      If Not sw_termsent Then
        sw_termsent = True
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(WILLTEL) + Chr$(TERMTYPE)
      End If
    Case NAWS
      Debug.Print "NAWS"
      ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(SB) + Chr$(NAWS) + Chr$(0) + Chr$(80) + Chr$(0) + Chr$(24) + Chr$(IAC) + Chr$(SE)
    Case Else
      Debug.Print "OTHER"
      ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(WONTTEL) + ch
  End Select

End Function

Function iac3 (ch As String) As Integer

  ' WILL Processing

  iac3 = GO_NORM

  Select Case Asc(ch)
    Case SGA
      Debug.Print "SGA"
      If Not sw_ugoahead Then
        sw_ugoahead = True
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(DOTEL) + Chr$(SGA)
        Debug.Print "SENT: DO SGA"
      End If
    Case ECHO
      Debug.Print "ECHO"
      If Not sw_echo Then
        sw_echo = True
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(DOTEL) + Chr$(ECHO)
        Debug.Print "SENT: DO ECHO"
      End If
    Case TIMING
      Debug.Print "TIMING"
      sw_timing = 0
    Case Else
      Debug.Print "SENT:  DONT OTHER"
      ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(DONTTEL) + ch
  End Select

End Function

Function iac4 (ch As String) As Integer

  ' WONT Processing

  iac4 = GO_NORM

  Select Case Asc(ch)
    Case ECHO
      Debug.Print "ECHO"
      If sw_echo Then
        sw_echo = False
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(DONTTEL) + Chr$(ECHO)
        Debug.Print "SENT: DONT ECHO"
      End If
    Case TIMING
      Debug.Print "TIMING"
      sw_timing = 0
    Case Else
      Debug.Print "SENT: DONT OTHER"
      ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(DONT) + ch
  End Select

End Function

Function iac5 (ch As String) As Integer

  ' Collect parms after SB and until another IAC

  ich = Asc(ch)

  If ich = IAC Then
    iac5 = GO_IAC1
    Exit Function
  End If

  Debug.Print "SUBPARM ";
  parsedata(ppno) = ich
  ppno = ppno + 1

  iac5 = GO_IAC5

End Function

Function iac6 (ch As String) As Integer

  ' End of negotiation string, string is in parsedata()

  Select Case parsedata(0)
    Case TERMTYPE
      If parsedata(1) = 1 Then
        Debug.Print "SENT: SB TERMTYPE VT100"
        ftp_form.ftpcntl.Send = Chr$(IAC) + Chr$(SB) + Chr$(TERMTYPE) + "vt100" + Chr$(0) + Chr$(IAC) + Chr$(SE)
      End If
  End Select

End Function

Sub info_DragDrop (Source As Control, X As Single, Y As Single)

Dim p1, p2 As Integer

  If Source = lfile Then
    log_message "        Date/Time: " + FileDateTime(lfile_path) + " Size:" + Str$(FileLen(lfile_path))
    log_message "INFO for " + lfile_path
  ElseIf Source = rfile Then
    mousepointer = HOURGLASS
    rfile.Enabled = False
    dbuf = ""
    open_data_port
    If 2 <> cntl_recv(2) Then
      mousepointer = DEFAULT
      rfile.Enabled = True
      Exit Sub
    End If
    data_type = DT_LIST
    cntl_send "LIST " + rfile_path
    If 2 <> cntl_recv(2) Then
      mousepointer = DEFAULT
      rfile.Enabled = True
      Exit Sub
    End If

    Do While data_socket <> 0
      z = DoEvents()
    Loop
    ' dbuf now contains the file list
    log_message "     " + Left$(dbuf, Len(dbuf) - 2)
    log_message "INFO for " + rfile_path

    rfile.Enabled = True
    mousepointer = DEFAULT
  End If

  lfile.DragMode = 0
  rfile.DragMode = 0

End Sub

Sub lfile_DblClick ()

Dim i As Integer

  i = lfile.ListIndex
  If i < 1 Then
    Exit Sub
  End If

  If lfile.PictureType(i) = 0 Then
    local_dir i
  End If

End Sub

Sub lfile_DragDrop (Source As Control, X As Single, Y As Single)

Dim i As Integer

  If Source = rfile Then
    i = lfile.TopIndex + (Y / txth) - 1
    If i < 0 Or i > lfile.ListCount - 1 Then
      Exit Sub
    End If
    lfile.ListIndex = i
    'only allow drop into a directory
    If rfile.PictureType(i) = 0 Then
      lfile_path = lfile.FullPath(i)
      lfile_name = ""
      data_type = DT_RECEIVE
      copy_from.Caption = rfile_path
      copy_to.Caption = lfile_path + "\" + rfile_name
      copy_rename.Text = rfile_name
      function_child.Left = 1500
      function_child.Top = drive1.Height + Y - (function_child.Height / 3)
      function_child.Visible = True
    Else
      MsgBox "Can't copy to a file, drop onto a directory"
      lfile.DragMode = 0
      rfile.DragMode = 0
    End If
  End If

End Sub

Sub lfile_PictureClick (ListIndex As Integer)

  lfile.ListIndex = ListIndex
  If lfile.PictureType(ListIndex) = 2 Then
    lfile_path = lfile.FullPath(ListIndex)
    lfile_name = lfile.List(ListIndex)
    lfile.DragMode = 1
  End If

End Sub

Sub local_dir (i As Integer)

Dim idt As Integer
Dim isave As Integer

  mousepointer = HOURGLASS
  lfile.Enabled = False


  If i < 0 Then
    ChDir "\"
    lfile.Clear
    lfile.AddItem Left$(CurDir$, 2), 0
    lfile.Indent(0) = 1
    isave = 0
    i = 0
    idt = 1
  Else
    ChDir lfile.FullPath(i)
    isave = i
    idt = lfile.Indent(i)
  End If

  i = i + 1
  n$ = Dir$("*.*", 16)
  Do While n$ <> ""
    If Left$(n$, 1) <> "." Then
      If GetAttr(n$) = 16 Then
        lfile.AddItem n$, i
        lfile.Indent(i) = idt + 1
        lfile.PictureType(i) = 0
        i = i + 1
      End If
    End If
    n$ = Dir$
  Loop

  n$ = Dir$("*.*", 7)
  Do While n$ <> ""
    lfile.AddItem n$, i
    lfile.Indent(i) = idt + 1
    lfile.PictureType(i) = 2
    n$ = Dir$
    i = i + 1
  Loop

  lfile.Expand(isave) = True

  lfile.Enabled = True
  mousepointer = DEFAULT

End Sub

Sub log_message (msg As String)

  status_list.AddItem msg, 0
  If status_list.ListCount = 50 Then
    status_list.RemoveItem 49
  End If

End Sub

Sub logoff ()

  rfile.Clear
  rfile.Enabled = False

  If data_socket Then
    cntl_send Chr$(255) + Chr$(244) + "ABOR"
    ftpdata(data_socket).Open = False
  End If

  If ftpdata(0).Open Then
    ftpdata(0).Open = False
  End If

  If ftpcntl.Open Then
    cntl_send Chr$(255) + Chr$(244) + "QUIT"
    ftpcntl.Open = False
  End If

End Sub

Function logon () As Integer

Dim st As Integer

  logon = 2 ' assume we succeed

  If ftpcntl.Open Then
    Exit Function
  End If

  ftpcntl.IPName = IPName
  ftpcntl.Port = 21

  On Error Resume Next
  ftpcntl.Open = True
  If Err Then
    MsgBox "Host connection failed with WinSock code " + Str$(Err)
    logon = 5
    Exit Function
  End If

  ' wait for FTP host to send welcome (220) message

  Do While 2 <> cntl_recv(2): Loop

  cntl_send "USER " + userid
  st = cntl_recv(2)
  If st <> 3 Then
    logon = st
    Exit Function
  End If

  If LCase$(Trim$(userid)) = "anonymous" Then
    ip = ftpcntl.MyIP
    For X = 1 To 4
      r$ = Trim$(Str$(ip And 255)) + "." + r$
      ip = ip / 256
    Next X
    password = "anonymous@" + Left$(r$, Len(r$) - 1)
  End If

  cntl_send "PASS " + password
  st = cntl_recv(2)
  If st = 3 Then
    cntl_send "ACCT " + account
    st = cntl_recv(2)
    If st <> 2 Then
      logon = st
      Exit Function
    End If
  ElseIf st <> 2 Then
    logon = st
    Exit Function
  End If

  rfile.Enabled = True

End Function

Sub menu_connect_Click ()

  mousepointer = HOURGLASS

  status_list.Clear
  logoff

  connect_form.Show 1
  If IPName = "" Then
    mousepointer = DEFAULT
    Exit Sub
  End If

  If 2 = logon() Then ' should always end up with 2 on logon
    rmt_dir True
  Else
    logoff
  End If

  mousepointer = DEFAULT

End Sub

Sub menu_disconnect_Click ()

  mousepointer = HOURGLASS

  logoff
  'status_list.Clear

  mousepointer = DEFAULT

End Sub

Sub menu_exit_click ()

Dim ln As String * 80
Dim nm As String

  mousepointer = HOURGLASS

  logoff

  ln = Str$(menu_verbose.Checked)
  z = PutINIString("Settings", "Verbose", ln, "vtftp.ini")

  ln = Str$(menu_port_cycle.Checked)
  z = PutINIString("Settings", "CyclePort", ln, "vtftp.ini")

  For X = 1 To 99
    nm = "IP" + Trim$(Str$(X))
    If X <= connect_form.conn_ipname.ListCount Then
      ln = connect_form.conn_ipname.List(X - 1)
      z = PutINIString("FTP Sites", nm, ByVal ln, "vtftp.ini")
    Else
      z = PutINIString("FTP Sites", nm, 0&, "vtftp.ini")
    End If
  Next X

  End

End Sub

Sub menu_lcl_refresh_Click ()

  local_dir True

End Sub

Sub menu_mode_block_click ()

  menu_mode_block.Checked = True
  menu_mode_compressed.Checked = False
  menu_mode_stream.Checked = False

  button_mode.Caption = "Block"

End Sub

Sub menu_mode_compressed_click ()

  menu_mode_block.Checked = False
  menu_mode_compressed.Checked = True
  menu_mode_stream.Checked = False

  button_mode.Caption = "Compress"

End Sub

Sub menu_mode_stream_click ()

  menu_mode_block.Checked = False
  menu_mode_compressed.Checked = False
  menu_mode_stream.Checked = True

  button_mode.Caption = "Stream"

End Sub

Sub menu_port_cycle_Click ()

  If menu_port_cycle.Checked Then
    menu_port_cycle.Checked = False
  Else
    menu_port_cycle.Checked = True
  End If

End Sub

Sub menu_rmt_refresh_Click ()

  If ftpcntl.Open Then
    rmt_dir True
  Else
    MsgBox "Can't refresh an unopened file structure"
  End If

End Sub

Sub menu_type_ascii_click ()

  menu_type_binary.Checked = False
  menu_type_ascii.Checked = True

  button_type.Caption = "ASCII"

End Sub

Sub menu_type_binary_click ()

  menu_type_binary.Checked = True
  menu_type_ascii.Checked = False

  button_type.Caption = "Binary"

End Sub

Sub menu_verbose_Click ()

  If menu_verbose.Checked Then
    menu_verbose.Checked = False
  Else
    menu_verbose.Checked = True
  End If

End Sub

Sub open_data_port ()

Static Port As Integer
Dim ip As Long
Dim X As Integer

  ip = ftpcntl.MyIP
  For X = 1 To 4
    r$ = Trim$(Str$(ip And 255)) + "," + r$
    ip = Int(ip / 256)
  Next X

  If data_socket <> 0 Then
    ftpdata(data_socket).Open = False
  End If

  Do While data_socket <> 0
    z = DoEvents()
  Loop

  If Port > 10 Then
    Port = 0
  End If

  If menu_port_cycle.Checked Then
    Port = Port + 1
  End If

  If ftpdata(0).Open Then
    ftpdata(0).Open = False
  End If

  ftpdata(0).Port = DATA_PORT * 256 + Port
  ftpdata(0).Open = True

  cntl_send "PORT " + r$ + Trim$(Str$(DATA_PORT)) + "," + Trim$(Str$(Port))

End Sub

Sub rfile_DblClick ()

Dim i As Integer

  i = rfile.ListIndex
  If i < 1 Then
    Exit Sub
  End If

  If rfile.PictureType(i) = 0 Then
    rmt_dir i
  End If

End Sub

Sub rfile_DragDrop (Source As Control, X As Single, Y As Single)

Dim i As Integer

  If Source = lfile Then
    i = rfile.TopIndex + (Y / txth) - 1
    If i < 0 Or i > lfile.ListCount - 1 Then
      Exit Sub
    End If
    rfile.ListIndex = i
    ' only allow drop into a directory
    If rfile.PictureType(i) = 0 Then
      rfile_path = Right$(rfile.FullPath(i), Len(rfile.FullPath(i)) - 1)
      rfile_name = ""
      data_type = DT_SEND
      copy_from.Caption = lfile_path
      copy_to.Caption = rfile_path + "/" + lfile_name
      copy_rename.Text = lfile_name
      function_child.Left = 1500
      function_child.Top = drive1.Height + lfile.Height + Y - (function_child.Height / 3)
      function_child.Visible = True
    Else
      MsgBox "Can't copy to a file, drop onto a directory"
      lfile.DragMode = 0
      rfile.DragMode = 0
    End If
  End If

End Sub

Sub rfile_PictureClick (ListIndex As Integer)

  rfile.ListIndex = ListIndex
  If rfile.PictureType(ListIndex) = 2 Then
    rfile_path = Right$(rfile.FullPath(ListIndex), Len(rfile.FullPath(ListIndex)) - 1)
    rfile_name = rfile.List(ListIndex)
    rfile.DragMode = 1
  End If

End Sub

Sub rmt_dir (i As Integer)

Dim idt As Integer
Dim p1 As Integer
Dim p2 As Integer
Dim isave As Integer

  mousepointer = HOURGLASS
  rfile.Enabled = False

  dbuf = ""

  open_data_port ' establishes listening data connection
  If 2 <> cntl_recv(2) Then
    mousepointer = DEFAULT
    rfile.Enabled = True
    Exit Sub
  End If

  data_type = DT_LIST
  If i < 0 Then
    cntl_send "CWD /"
    If 2 <> cntl_recv(2) Then
      mousepointer = DEFAULT
      rfile.Enabled = True
      Exit Sub
    End If
    cntl_send "LIST"
    If 2 <> cntl_recv(2) Then
      mousepointer = DEFAULT
      rfile.Enabled = True
      Exit Sub
    End If
    rfile.Clear
    rfile.AddItem "/", 0
    rfile.Indent(0) = 1
    isave = 0
    i = 0
    idt = 1
  Else
    cntl_send "LIST " + Right$(rfile.FullPath(i), Len(rfile.FullPath(i)) - 1)
    If 2 <> cntl_recv(2) Then
      mousepointer = DEFAULT
      rfile.Enabled = True
      Exit Sub
    End If
    isave = i
    idt = rfile.Indent(i)
  End If

  Do While data_socket <> 0
    z = DoEvents()
  Loop

  ' dbuf now contains the complete directory list

  i = i + 1

  ' first pass is for directories only

  p1 = 1
  p2 = 1
  Do While p2 > 0
    p2 = InStr(p1, dbuf, Chr$(10))
    If p2 > 0 Then
      ln$ = Mid$(dbuf, p1, p2 - p1)
      If Left$(ln$, 1) = "d" Then
        n$ = Trim$(Mid$(ln$, 55, Len(ln$) - 55))
        rfile.AddItem n$, i
        rfile.Indent(i) = idt + 1
        rfile.PictureType(i) = 0
        i = i + 1
      End If
    End If
    p1 = p2 + 1
  Loop

  ' make a second pass for files only

  p1 = 1
  p2 = 1
  Do While p2 > 0
    p2 = InStr(p1, dbuf, Chr$(10))
    If p2 > 0 Then
      ln$ = Mid$(dbuf, p1, p2 - p1)
      If Left$(ln$, 1) = "-" Then
        n$ = Trim$(Mid$(ln$, 55, Len(ln$) - 55))
        rfile.AddItem n$, i
        rfile.Indent(i) = idt + 1
        rfile.PictureType(i) = 2
        i = i + 1
      End If
    End If
    p1 = p2 + 1
  Loop

  rfile.Expand(isave) = True
  rfile.Enabled = True
  mousepointer = DEFAULT

End Sub

Sub transfer_cancel_Click ()

  cntl_send Chr$(255) + Chr$(244)
  cntl_send "ABOR"
  Hide

End Sub

Sub trash_DragDrop (Source As Control, X As Single, Y As Single)

  On Error Resume Next

  If Source = lfile Then
    If MsgBox("Delete " + lfile_path + "?", 36) = 6 Then
      Kill lfile_path
      If Err Then
        log_message "!!! " + lfile_name + " NOT DELETED !!!"
        log_message "!!! Error" + Str$(Err) + " while deleting " + lfile_name

        lfile.DragMode = 0
        rfile.DragMode = 0
        Exit Sub
      End If
      lfile.RemoveItem lfile.ListIndex
    End If
  ElseIf Source = rfile Then
    If MsgBox("Delete " + rfile_path + "?", 36) = 6 Then
      cntl_send "DELE " + rfile_path
      z = cntl_recv(1)
      rfile.RemoveItem rfile.ListIndex
    End If
  End If

  lfile.DragMode = 0
  rfile.DragMode = 0

End Sub